home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / glisp / glisp.000 / GLISP.UNIX.TAR / closunix / clos_ux1.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-04-03  |  3.2 KB  |  191 lines
  1. /*                 GRAPHIC LISP            */
  2. /*        Scritto nel 1991-94 da Zoia Andrea Michele     */
  3. /*        Via Pergola #1 Tirano (SO) Tel. 0342-704210    */
  4. /*           codice non ansi per XENIX & UNIX    */
  5. /* file clos_ux1.c */
  6.  
  7. #include <sys/types.h>
  8. #include <sys/timeb.h>
  9. #include <signal.h>
  10. #include "clos.h"
  11. #include "closerr.h"
  12. #include "closnans.h"
  13.  
  14. void disp();
  15.  
  16. int clos_non_ansi_init()
  17. {
  18.  signal(SIGINT,disp);
  19.   printf("\n\n\n");                        
  20.  printf(
  21. " ------------------>   Common Lisp Object System   V%s <------------------ \n",CLOS_VERSION);
  22.                         /*   05  */
  23.  printf(
  24. "----------------> (c) 1991--1994 By Andrea Michele Zoia <----------------------\n");
  25.          
  26.  printf(
  27. "------------------------------>  For Xenix  <----------------------------------\n");
  28.  return OK;
  29. }
  30.  
  31. void disp(par)
  32. int par;
  33. {
  34.  signal(SIGINT,disp);
  35.  longjmp(critical_jmp,LONGJMP_CONTROLC);
  36. }
  37.  
  38.  
  39. void clos_non_ansi_exit()
  40. {
  41.  exit(0);
  42. }
  43.  
  44. int cl_beep(freq)
  45. int freq;
  46. {
  47.  return OK;
  48. }
  49.  
  50. int cl_getch()
  51. {
  52.  return 13;
  53. }
  54.  
  55. long na_millitime()
  56. {
  57.  /* ritorna il timer in millisecondi */
  58.  struct timeb t;
  59.  long tmp;
  60.  
  61.  ftime(&t);
  62.  
  63.  tmp=t.time;
  64.  tmp*=1000;
  65.  tmp+=(long)t.millitm;
  66.  return tmp;
  67. }
  68.  
  69.  
  70. char *matherr_names[6]={
  71.     "DOMAIN",
  72.     "SINGgularity",
  73.     "OVERFLOW",
  74.     "UNDERFLOW",
  75.     "Total LOSS of precision",
  76.     "Partial LOSS of precision"
  77. };
  78. int matherr(e)
  79. struct exception *e;
  80. {
  81.  char buffer[200];
  82.  sprintf(buffer,
  83.     "type<%s>,function name<%s>,argument1<%f>,argument2(zero if nonexistent)<%f>",
  84.     matherr_names[e->type-1],e->name,e->arg1,e->arg2
  85.  );
  86.  error(E_MATH,ERR_MERROR|ERR_PSTRING|ERR_TBLVL,buffer);
  87.  return 1;
  88. }
  89.  
  90.  
  91. void stack_backtrace()
  92. {
  93. }
  94.  
  95.  
  96.  
  97. /*****************   EMULAZIONE TERMINALE ***************/
  98. /* put_char, put_string, get_char, get_string, curpos    */
  99. /********************************************************/
  100.  
  101. int lisp_curpos(x,y)
  102. int x;
  103. int y;
  104. {
  105.  if(x>=1 && x<=80 && y>=1 && y<=25)
  106.    printf("%c[%u;%uf",27,26-y,x);
  107. }
  108.  
  109. int lisp_charcolor(fore,back,attrib)
  110. n_int fore;
  111. n_int back;
  112. n_int attrib;
  113. {
  114.  if(attrib>=1 && attrib <=9)
  115.    printf("%c[%um",27,(int)(attrib-1));
  116.  if(back>=1 && back <=8)
  117.    printf("%c[%um",27,(int)(39+back));
  118.  if(fore>=1 && fore <=8)
  119.    printf("%c[%um",27,(int)(29+fore));
  120.  
  121. }
  122. int lisp_cls()
  123. {
  124.  printf("%c[2J",27);
  125.  printf("%c[%u;%uf",27,24,0);
  126. }
  127.  
  128. int lisp_put_char(c,f)
  129. int c;
  130. FILE *f;
  131. {
  132.  /* ritorna c oppure EOF se c'e' qualche errore */
  133.  if(f==stdout || f==stderr){
  134.    if(dribble_file)fputc(c,dribble_file);
  135.  }
  136.  return f?fputc(c,f):EOF;
  137. }
  138.  
  139. int lisp_print_string(s,f)
  140. char *s;
  141. FILE *f;
  142. {
  143.  /* ritorna l'ultimo carattere della stringa oppure EOF se c'e' un errore */
  144.  int ret;
  145.  while(*s)ret=lisp_put_char(*s++,f);
  146.  return ret;
  147. }
  148.  
  149.  
  150. int lisp_get_char(f)
  151. FILE *f;
  152. {
  153.  int c;
  154.  c=f?getc(f):EOF;
  155.  if(f==stdin && c!=EOF && dribble_file)
  156.    fputc(c,dribble_file);
  157.  return c;
  158. }
  159.  
  160. int lisp_get_string(c,len,f)
  161. char *c;
  162. int len;
  163. FILE *f;
  164. {
  165.  /* len e' la lunghezza massima della stringa senza lo zero finale */
  166.  /* ritorna una stringa senza il newline finale */
  167.  
  168.  if(!f)return EOF;
  169.  if(!fgets(c,len+1,f))return EOF;
  170.  while(*c)c++;
  171.  if(*--c=='\n'){
  172.    *c=0;
  173.  }else{
  174.    if(f==stdin){
  175.      /* svuota il buffer della tastiera */
  176.      while(1){
  177.        switch(fgetc(f)){
  178.      case '\n':break;
  179.      case EOF: return EOF;
  180.      default: continue;
  181.        }
  182.        break;
  183.      }
  184.    }
  185.  }
  186.  if(f==stdin && dribble_file)
  187.    fputs(c,dribble_file);
  188.  return len;
  189. }
  190.  
  191.